home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / OS2 / PMCOM109.ARJ / HOST.CMD < prev    next >
OS/2 REXX Batch file  |  1991-09-04  |  32KB  |  982 lines
  1. /*                       PMCOMM HOST MODE                            */
  2. /*                      (C) Copyright 1990                           */
  3. /*                    Multi-Net Communications                       */
  4.  
  5. Signal ON SYNTAX  NAME SYNTAX_ERROR
  6. Signal ON NOVALUE NAME SYNTAX_ERROR
  7. Signal ON HALT    NAME KILL_HOST_MODE
  8. Parse arg port portname screen_handle dde_output dde_input semaphore
  9. Parse source . . fn .
  10.  
  11. Call RxFuncAdd "init_dll","RxPmcomm","init_dll"
  12. Call init_dll
  13.  
  14. Expose_list = 'cr crlf bs esc port screen_handle connection  dde_output  priv' ,
  15.               'dir_line. dir_name. dir_desc. fname  lname  default_dir' ,
  16.               'protocol last_login  total_logins  audit_file temp_file' ,
  17.               'pass_file pword semaphore upload_dir cmd_name. cmd_desc.',
  18.               'num_of_cmds help_file cmd_reqs dde_input'
  19.  
  20. Call Clear_buffer
  21. Call Drop_DTR port
  22. Call Sleep "2000"
  23. Call Raise_DTR port
  24. Call Getcom "baud",port
  25. initial_baud = result
  26.  
  27. Begin:
  28. Do Main = 1
  29.  
  30. header_file  = "D:\PMCOMM\SCRIPT\HOSTHEAD.FLE"
  31. pass_file    = "D:\PMCOMM\SCRIPT\HOSTPASS.FLE"
  32. temp_file    = "D:\PMCOMM\SCRIPT\HOST$$$$.FLE"
  33. audit_file   = "D:\PMCOMM\SCRIPT\HOSTAUDT.FLE"
  34. help_file    = "D:\PMCOMM\SCRIPT\HOSTHELP.FLE"
  35. newuser_file = "D:\PMCOMM\SCRIPT\HOSTNEWU.FLE"
  36. dir_file     = "D:\PMCOMM\SCRIPT\HOSTDIR.FLE"
  37. upload_dir   = "D:\PMCOMM\UPLOAD"
  38. modem_string = "AT &C1&D2 S0=1 X4"
  39. system       = "OPEN"                    /*    OPEN or CLOSED    */
  40. connection   = "MODEM"                   /*   MODEM or DIRECT    */
  41. Baud         = "AUTO"                    /*     AUTO or rate     */
  42.  
  43. Call Setcom initial_baud,"","","",port
  44.  
  45. max_attempts = 3
  46. bs   = '08'x
  47. cr   = '0d'x
  48. esc  = '1b'x
  49. crlf = '0d0a'x
  50.  
  51. Parse value Directory() with orgdir
  52.  
  53. Call read_timeout "5000",port
  54. If connection = 'MODEM' then
  55.   Do
  56.      Do Forever
  57.        Call Put_s 'ATZ'||cr,port
  58.        Call wait_for "OK",port
  59.        Call Sleep "2000"
  60.        Call Put_s modem_string||cr,port
  61.        Call wait_for "OK",port
  62.        If result = 1 then leave
  63.     End
  64. End
  65.  
  66. If system = 'CLOSED' then
  67.    Do
  68.      Parse value state_file(pass_file) with rc
  69.      If rc = '' then
  70.         Do
  71.           Call Put_s 'Password file missing' crlf,screen_handle
  72.           Call Put_s 'The password file must exist for CLOSED system operation ...' crlf,screen_handle
  73.           Signal Kill_Host_mode
  74.         End
  75.    End
  76.  
  77. Parse value state_file(dir_file) with rc
  78. If rc = '' then
  79.    Do
  80.      Call Put_s 'Directory file missing ...' crlf,screen_handle
  81.      Signal Kill_Host_mode
  82.    End
  83. i=0
  84. Do until lines(dir_file) = 0
  85.    Parse value linein(dir_file) with temp_line
  86.    If substr(temp_line,1,1) = '*' then iterate
  87.    i=i+1
  88.    Parse var temp_line dir_line.i
  89.    Parse var dir_line.i dir_name.i dir_desc.i
  90.    tempname = pos("\",dir_name.i)
  91.    If tempname = 0 then dir_name.i = dir_name.i||'\'
  92.    dir_desc.i = space(dir_desc.i)
  93.    dir_name.i = translate(dir_name.i)
  94. End
  95. dir_line.0 = i
  96. Parse value stream(dir_file,"c","close") with rc
  97.  
  98. Parse value Directory(dir_name.1) with default_dir
  99. If default_dir \= '' then
  100.    Do
  101.      Call Clear
  102.      Call Put_s 'Default directory changed to' default_dir crlf,screen_handle
  103.    End
  104.    Else do
  105.      Call Clear
  106.      Call Put_s 'Default directory' default_dir 'not found ...' crlf,screen_handle
  107.      Signal Kill_Host_mode
  108.    End
  109.  
  110. If upload_dir \= '' then Call Set_Download_Path upload_dir,dde_output
  111.  
  112.  
  113. Connection_Pending:
  114. Call Put_s 'PMCOMM now running in HOST mode' crlf crlf,screen_handle
  115. Call Put_s 'Waiting for connection ...' crlf,screen_handle
  116. Call read_timeout "60000",port
  117. If connection = 'MODEM' then
  118.   Do
  119.     If baud = "AUTO" then
  120.     Do
  121.        Do Forever
  122.           Call Wait_fore '1200','2400','4800','9600',port,screen_handle
  123.           match = result
  124.           Select
  125.                When match = 0 then iterate
  126.                When match = 1 then Call Setcom "1200","N","8","1",port
  127.                When match = 2 then Call Setcom "2400","N","8","1",port
  128.                When match = 3 then Call Setcom "4800","N","8","1",port
  129.                When match = 4 then Call Setcom "9600","N","8","1",port
  130.                Otherwise nop
  131.           End
  132.        Leave
  133.        End
  134.     End
  135.     Else Do
  136.        Call Setcom baud,"N","8","1",port
  137.        Do Forever
  138.           Call Wait_fore 'CONNECT',port,screen_handle
  139.           If result = 1 then leave
  140.        End
  141.      End
  142. End
  143.  
  144. Call Sleep "5000"
  145. Parse value Header(header_file) with rc
  146. invalid_login_count = 0
  147.  
  148. Sign_on:
  149. Do Forever
  150. fname = '' ; lname = '' ; pword = '' ; nuser = 'N'
  151. Parse value read_with_echo("Your first name?-> ") with rc fname .
  152. If rc \=0 then leave main
  153. If fname = '' then iterate
  154. Parse value read_with_echo(" Your last name?-> ") with rc lname .
  155. If rc \=0 then leave main
  156. If lname = '' then iterate
  157.  
  158. Parse value read_password_file(pass_file) with rc priv protocol r_pass total_logins last_login
  159. If rc \= 0  then
  160.  Do
  161.    If system = 'OPEN' then
  162.       Do
  163.          Parse value read_with_echo(fname lname||", correct - [Y]es or [Return], [N]o?->") with rc okname .
  164.          If rc \=0 then leave main
  165.          If okname \= 'Y' & okname \= '' then iterate
  166.          Parse value Header(newuser_file) with rc
  167.          Parse value read_with_echo("Would you like to register - [Y]es or [Return], [N]o?->") with rc nuser .
  168.          If rc \=0 then leave main
  169.          If nuser \= 'Y' & nuser \= '' then leave main
  170.          r_pass = ''
  171.       End
  172.       Else Do
  173.          Call Put_s crlf||"Closed System, no access allowed" crlf,port
  174.          Call Put_s crlf||"Closed System, no access allowed" crlf,screen_handle
  175.          Leave main
  176.       End
  177.  End
  178.  
  179. Parse value read_without_echo("Enter your password (.'s will echo)-> ") with rc pword .
  180. If pword = '' then iterate
  181. If rc \=0 then leave main
  182. If r_pass = '' then r_pass = pword
  183. If nuser  = 'Y' | nuser = '' then Call Add_password_file(pass_file)
  184. If pword \== r_pass then
  185.   Do
  186.     If invalid_login_count = max_attempts then leave main
  187.     Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,port
  188.     Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,screen_handle
  189.     invalid_login_count = invalid_login_count + 1
  190.     Iterate
  191. End
  192. Leave
  193. End
  194.  
  195. login_msg = "Login by" fname "at" time('C') 'on' date('L') ', last login was on' last_login
  196. Call Put_s crlf crlf||login_msg crlf,port
  197. Call Put_s crlf crlf||Login_msg crlf,screen_handle
  198. Call Audit(date('L') time('C') "- Login by" fname lname)
  199. rc = time("R")
  200.  
  201. Menu_loop:
  202.  
  203. Do Forever
  204. Call Put_s crlf crlf, port
  205. Call Put_s crlf crlf, screen_handle
  206.  
  207. Call Build_Menu
  208.  
  209. cmdline = ''
  210. heading = crlf crlf crlf center("--- Main Options Menu ---",79)
  211. Call Put_s heading crlf crlf,port
  212. Call Put_s heading crlf,screen_handle
  213. Do i = 1  by 2 to num_of_cmds
  214.    j=i+1
  215.    line = overlay(cmd_name.j cmd_desc.j,cmd_name.i cmd_desc.i,40)
  216.    Call Put_s line crlf,port
  217.    Call Put_s line crlf,screen_handle
  218.    cmdline = cmdline substr(cmd_name.i,2,1) substr(cmd_name.j,2,1)
  219. End
  220. cmdline = space(cmdline,1,',')
  221. Parse value read_with_echo("Enter choice" cmdline||"?-> ") with rc pick .
  222. If rc \= 0 then leave main
  223. If pick = '' then iterate
  224. if  pos(pick, cmd_reqs) = 0  then  iterate
  225.  
  226. Select
  227.      When pick = "C" then Parse value Change_Dir() with rc
  228.      When pick = "D" then Parse value File_Transfer("DOWNLOAD") with rc
  229.      When pick = "F" then Parse value List_Files() with rc
  230.      When pick = "G" then Parse value Good_Bye() with rc
  231.      When pick = "H" then Parse value Help_Text() with rc
  232.      When pick = "I" then Parse value User_Information() with rc
  233.      When pick = "L" then Parse value List_Directories() with rc
  234.      When pick = "S" then Parse value Shell_OS2() with rc
  235.      When pick = "T" then Signal Kill_Host_Mode
  236.      When pick = "U" then Parse value File_Transfer("UPLOAD") with rc
  237.      Otherwise iterate
  238. End
  239. If rc \=0 then leave main
  240. End
  241.  
  242. Call Clear_buffer
  243. Call Drop_DTR port
  244. Call Sleep "2000"
  245. Call Raise_DTR port
  246. Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle
  247.  
  248. End
  249.  
  250. Call Clear_buffer
  251. Call Drop_DTR port
  252. Call Sleep "2000"
  253. Call Raise_DTR port
  254. Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle
  255. Signal Begin
  256.  
  257.  
  258.  
  259.  
  260. /*  Here are all the subroutines that the MAINLINE section of HOST   */
  261. /*  uses.  HOST  mode is structured so that all call return to the   */
  262. /*  main loop(s).                                                    */
  263.  
  264. /* Clear Screen Routine                                              */
  265. Clear: Procedure expose (expose_list)
  266. Call put_s "1b5b324a"x,screen_handle
  267. Call put_s "1b5b324a"x,screen_handle
  268. Call put_s "1b5b324a"x,port
  269. Call put_s "1b5b324a"x,port
  270. Return
  271.  
  272.  
  273. /* Standard handler for SIGNAL on ERROR, will help in the debuging   */
  274. syntax_error:
  275. fp = filespec("path",fn)
  276. fd = filespec("drive",fn)
  277. errormsg='REXX error' rc 'in line' sigl':' errortext(rc)
  278. errorfile = fd||fp||"SCRIPT.ERR"
  279. rc = lineout(errorfile,date() time() fn '-' errormsg)
  280. rc = lineout(errorfile,date() time() fn '-' sourceline(sigl))
  281. Exit
  282.  
  283.  
  284. /* Standard file transfer routine for all protocols that PMCOMM has  */
  285. File_Transfer: Procedure expose (expose_list)
  286. Parse arg direction
  287.  
  288. Do i=1 until i=dir_line.0
  289.    If default_dir = dir_name.i then
  290.       Do
  291.          Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,port
  292.          Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,screen_handle
  293.          i = 0
  294.          Leave
  295.       End
  296. End
  297. If i \=0 then
  298.    Do
  299.       Call Put_s crlf||"Current directory is " default_dir crlf,port
  300.       Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
  301.    End
  302.  
  303. If protocol \= 'NONE' then
  304.    Do
  305.       Call Put_s "Current file transfer protocol is" protocol crlf,port
  306.       Call Put_s "Current file transfer protocol is" protocol crlf,screen_handle
  307.       t_protocol = protocol
  308.    End
  309. Do Forever
  310.   Parse value read_with_echo("Enter file name or Tap [Return] to abort?-> ") with rc dfn .
  311.   If rc \=0 then return rc
  312.   Parse var dfn fn '.' ft
  313.   If dfn = '' then return 0
  314.   If ft = '' then
  315.      Do
  316.        Call Put_s crlf||"Invalid filename ..." crlf,port
  317.        Call Put_s crlf||"Invalid filename ..." crlf,screen_handle
  318.        Iterate
  319.      End
  320.   If direction = "DOWNLOAD" then
  321.      Do
  322.        tempname = reverse(default_dir)
  323.        If pos("\",tempname) = 1 then file_name = default_dir||dfn
  324.           else file_name = default_dir||"\"||dfn
  325.        Parse value State_file(file_name) with rc
  326.        If rc = '' then
  327.           Do
  328.             Call Put_s crlf||"File not found ..." crlf,port
  329.             Call Put_s crlf||"File not found ..." crlf,screen_handle
  330.             Iterate
  331.           End
  332.      End
  333.   If direction = "UPLOAD" then
  334.      Do
  335.        tempname = reverse(default_dir)
  336.        If pos("\",tempname) = 1 then file_name = default_dir||dfn
  337.           else file_name = default_dir||"\"||dfn
  338.        Parse value State_file(file_name) with rc
  339.        If rc = file_name then
  340.           Do
  341.             Call Put_s crlf||"File already exists ..." crlf,port
  342.             Call Put_s crlf||"File already exists ..." crlf,screen_handle
  343.             Iterate
  344.           End
  345.      End
  346. Leave
  347. End
  348.  
  349. Parse value read_with_echo("Logoff after file transfer - [N]o or [Return], [Y]?-> ") with rc auto .
  350. If rc \=0 then return rc
  351. If protocol = 'NONE' then
  352.    Do
  353.       Parse value Set_protocol('NONE') with rc
  354.       t_protocol = protocol
  355.       protocol = 'NONE'
  356.    End
  357.  
  358. Select
  359.     When t_protocol = "XMODEM" & direction = "DOWNLOAD"  then
  360.          do
  361.             Call Put_s crlf||"Ready to send file ..." crlf,port
  362.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  363.             Call xmodem_chk_send file_name,dde_output,dde_input
  364.             ft_rc = result
  365.          end
  366.     When t_protocol = "XMODEM" & direction = "UPLOAD"  then
  367.          do
  368.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  369.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  370.             Call xmodem_chk_receive file_name,dde_output,dde_input
  371.             ft_rc = result
  372.          end
  373.     When t_protocol = "XMODEM-CRC" & direction = "DOWNLOAD"  then
  374.          do
  375.             Call Put_s crlf||"Ready to send file ..." crlf,port
  376.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  377.             Call xmodem_send file_name,dde_output,dde_input
  378.             ft_rc = result
  379.          end
  380.     When t_protocol = "XMODEM-CRC" & direction = "UPLOAD"  then
  381.          do
  382.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  383.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  384.             Call xmodem_receive file_name,dde_output,dde_input
  385.             ft_rc = result
  386.          end
  387.     When t_protocol = "XMODEM-1K" & direction = "DOWNLOAD"  then
  388.          do
  389.             Call Put_s crlf||"Ready to send file ..." crlf,port
  390.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  391.             Call xmodem_1k_send file_name,dde_output,dde_input
  392.             ft_rc = result
  393.          end
  394.     When t_protocol = "XMODEM-1K" & direction = "UPLOAD"  then
  395.          do
  396.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  397.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  398.             Call xmodem_1k_receive file_name,dde_output,dde_input
  399.             ft_rc = result
  400.          end
  401.     When t_protocol = "YMODEM" & direction = "DOWNLOAD"  then
  402.          do
  403.             Call Put_s crlf||"Ready to send file ..." crlf,port
  404.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  405.             Call ymodem_send file_name,dde_output,dde_input
  406.             ft_rc = result
  407.          end
  408.     When t_protocol = "YMODEM" & direction = "UPLOAD"  then
  409.          do
  410.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  411.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  412.             Call ymodem_receive dde_output,dde_input
  413.             ft_rc = result
  414.          end
  415.     When t_protocol = "YMODEMG" & direction = "DOWNLOAD"  then
  416.          do
  417.             Call Put_s crlf||"Ready to send file ..." crlf,port
  418.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  419.             Call ymodemg_send file_name,dde_output,dde_input
  420.             ft_rc = result
  421.          end
  422.     When t_protocol = "YMODEMG" & direction = "UPLOAD"  then
  423.          do
  424.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  425.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  426.             Call ymodemg_receive dde_output,dde_input
  427.             ft_rc = result
  428.          end
  429.     When t_protocol = "KERMIT" & direction = "DOWNLOAD"  then
  430.          do
  431.             Call Put_s crlf||"Ready to send file ..." crlf,port
  432.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  433.             Call kermit_send file_name,dde_output,dde_input
  434.             ft_rc = result
  435.          end
  436.     When t_protocol = "KERMIT" & direction = "UPLOAD"  then
  437.          do
  438.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  439.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  440.             Call kermit_receive dde_output,dde_input
  441.             ft_rc = result
  442.          end
  443.     When t_protocol = "ZMODEM" & direction = "DOWNLOAD"  then
  444.          do
  445.             Call Put_s crlf||"Ready to send file ..." crlf,port
  446.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  447.             Call zmodem_send file_name,dde_output,dde_input
  448.             ft_rc = result
  449.          end
  450.     When t_protocol = "ZMODEM" & direction = "UPLOAD"  then
  451.          do
  452.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  453.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  454.             Call zmodem_receive dde_output,dde_input
  455.             ft_rc = result
  456.          end
  457.     Otherwise return 0
  458.     End
  459.  
  460. If ft_rc \= 0 then
  461.    Do
  462.      Call Sleep "3000"
  463.      Call Put_s crlf||'File transfer complete 'ft_rc||crlf,port
  464.      Call Put_s crlf||'File transfer complete 'ft_rc||crlf,screen_handle
  465.      If auto = "Y" then
  466.         Do
  467.           Parse value Good_bye() with rcode
  468.           return rcode
  469.         End
  470.      return 0
  471.    End
  472.    Else do
  473.      Call Sleep "3000"
  474.      Call Put_s crlf||'File transfer aborted' crlf,port
  475.      Call Put_s crlf||'File transfer aborted' crlf,screen_handle
  476.      If auto = "Y" then
  477.         Do
  478.           Parse value Good_bye() with rcode
  479.           return rcode
  480.         End
  481.      return 0
  482.    End
  483.  
  484.  
  485. Read_with_echo: Procedure expose (expose_list)
  486. Parse arg screen_output
  487.  
  488. Call Clear_buffer
  489. Call Read_timeout '3000',port
  490. Call Put_s crlf||screen_output,port
  491. Call Put_s crlf||screen_output,screen_handle
  492. line = ''
  493. j=0
  494. time_out = 0
  495.  
  496. Do Forever
  497. Parse value  Get_CH(port) with char_in
  498. If connection = 'MODEM' then
  499.   Do
  500.     Call DCD port
  501.     If result = 0 then return 99
  502.   End
  503.  
  504. If char_in = "-1" then
  505.    Do
  506.      time_out = time_out+1
  507.      If time_out = 60 then
  508.         Do
  509.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
  510.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
  511.            Parse value Good_bye() with rcode
  512.            return rcode
  513.         End
  514.      Iterate
  515.    End
  516.  
  517. If char_in = cr then
  518.    Do
  519.      Call Put_s crlf,port
  520.      Call Put_s crlf,screen_handle
  521.      line = space(line)
  522.      line = translate(line)
  523.      return 0 line
  524.    End
  525.  
  526. If char_in = bs then
  527.    Do
  528.      If j > 0 then
  529.        Do
  530.          line = delstr(line,j,1)
  531.          Call Put_s bs,port
  532.          Call Put_s bs,screen_handle
  533.          j=j-1
  534.        End
  535.    End
  536.    Else Do
  537.      line = line||char_in
  538.      Call Put_s char_in,port
  539.      Call Put_s char_in,screen_handle
  540.      j=j+1
  541.    End
  542. End
  543.  
  544.  
  545. Read_without_Echo: Procedure expose (expose_list)
  546. Parse arg screen_output
  547.  
  548. Call Clear_buffer
  549. Call Read_timeout '3000',port
  550. Call Put_s crlf||screen_output,port
  551. Call Put_s crlf||screen_output,screen_handle
  552. line = ''
  553. j=0
  554. time_out = 0
  555.  
  556. Do Forever
  557. Parse value  Get_CH(port) with char_in
  558. If connection = 'MODEM' then
  559.   Do
  560.     Call DCD port
  561.     If result = 0 then return 99
  562.   End
  563.  
  564. If char_in = "-1" then
  565.    Do
  566.      time_out = time_out+1
  567.      If time_out = 60 then
  568.         Do
  569.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
  570.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
  571.            Parse value Good_bye() with rcode
  572.            return rcode
  573.         End
  574.      Iterate
  575.    End
  576.  
  577. If char_in = cr then
  578.    Do
  579.      Call Put_s crlf,port
  580.      Call Put_s crlf,screen_handle
  581.      line = space(line)
  582.      line = translate(line)
  583.      return 0 line
  584.    End
  585.  
  586. If char_in = bs then
  587.    Do
  588.      If j > 0 then
  589.        Do
  590.          line = delstr(line,j,1)
  591.          Call Put_s bs,port
  592.          Call Put_s bs,screen_handle
  593.          j=j-1
  594.        End
  595.    End
  596.    Else Do
  597.      line = line||char_in
  598.      Call Put_s ".",port
  599.      Call Put_s char_in,screen_handle
  600.      j=j+1
  601.    End
  602. End
  603.  
  604.  
  605. Clear_buffer: Procedure expose (expose_list)
  606. Call Read_timeout '0',port
  607. Do Forever
  608.    Parse value Get_CH(port) with rc
  609.    If rc = "-1" then return
  610. End
  611. Return
  612.  
  613.  
  614. Help_text: Procedure expose (expose_list)
  615. Parse value Header(help_file) with rc
  616. If rc \=0 then
  617.    Do
  618.       Call put_s crlf||'Help file not available ...' crlf,port
  619.       Call put_s crlf||'Help file not available ...' crlf,screen_handle
  620.    End
  621. Return 0
  622.  
  623.  
  624. Read_password_file: Procedure expose (expose_list)
  625. Parse arg pass_file
  626. protocol = "NONE"
  627. r_fname = '' ; r_lname = '' ; r_pass = '' ; r_priv = ''
  628. r_protocol = protocol ; r_total_logins = '' ; r_last_login = ''
  629. Do until lines(pass_file) = 0
  630.    Parse value linein(pass_file) with pass_line
  631.    If substr(pass_line,1,1) = '*' then iterate
  632.    Parse upper var pass_line r_fname r_lname r_pass r_priv r_protocol r_total_logins r_last_login
  633.    If fname \== r_fname | lname \== r_lname then iterate
  634.    If r_protocol = '' then r_protocol = protocol
  635.    If r_total_logins = '' then r_total_logins = 0
  636.    r_total_logins = r_total_logins + 1
  637.    If r_last_login = '' then r_last_login = 'UNKNOWN'
  638.    Parse value stream(pass_file,"c","close") with rc
  639.    return 0 r_priv r_protocol r_pass r_total_logins r_last_login
  640. End
  641. Parse value stream(pass_file,"c","close") with rc
  642. Return 99 1 protocol 'DUMMY' 1 date('L')
  643.  
  644.  
  645. Update_Password_file: Procedure expose (expose_list)
  646. Parse arg pass_file temp_file
  647. Do until lines(pass_file) = 0
  648.    Parse value linein(pass_file) with pass_line
  649.    Parse upper var pass_line r_fname r_lname r_pass r_priv .
  650.    If fname \== r_fname | lname \== r_lname then
  651.       Do
  652.         Parse value lineout(temp_file,pass_line) with rc
  653.       End
  654.       Else Do
  655.         last_login = Date('L')
  656.         pass_line = r_fname r_lname pword r_priv protocol total_logins last_login
  657.         Parse value lineout(temp_file,pass_line) with rc
  658.       End
  659. End
  660. Parse value stream(pass_file,"c","close") with rc
  661. Parse value stream(temp_file,"c","close") with rc
  662. Address CMD "ERASE" pass_file
  663. pass_name = filespec("name",pass_file)
  664. Address CMD "RENAME" temp_file pass_name
  665. Return 0
  666.  
  667.  
  668. Add_Password_file: Procedure expose (expose_list)
  669. Parse arg pass_file
  670. pass_line = fname lname pword 1 protocol 1 date('L')
  671. Parse value lineout(pass_file,pass_line) with rc
  672. Parse value stream(pass_file,"c","close") with rc
  673. Return 0
  674.  
  675.  
  676. Header: Procedure expose (expose_list)
  677. Parse arg text_file
  678. Parse value state_file(text_file) with rc
  679. If rc = '' then return 99
  680. Call put_s crlf,port
  681. Call put_s crlf,screen_handle
  682. Do until lines(text_file) = 0
  683.    Parse value linein(text_file) with head_line
  684.    If substr(head_line,1,1) = '*' then iterate
  685.    Call put_s head_line crlf,port
  686.    Call put_s head_line crlf,screen_handle
  687. End
  688. Parse value stream(text_file,"c","close") with rc
  689. Return 0
  690.  
  691.  
  692. Audit: Procedure expose (expose_list)
  693. Parse arg audit_record
  694. Parse value lineout(audit_file,audit_record) with rc
  695. Return rc
  696.  
  697.  
  698. Build_Menu: Procedure expose (expose_list)
  699. command_tbl.   = ''
  700. command_tbl.1  = "[C]hange Active Directory (or drive) ; 5"
  701. command_tbl.2  = "[D]ownload A File ; 1"
  702. command_tbl.3  = "[F]iles (List current directory) ; 1"
  703. command_tbl.4  = "[G]oodbye (Disconnect) ; 0"
  704. command_tbl.5  = "[H]elp (Main command help) ; 0"
  705. command_tbl.6  = "[I]nformation (User defaults) ; 0"
  706. command_tbl.7  = "[L]ist File Directories ; 0"
  707. command_tbl.8  = "[S]hell To OS/2 ; 9"
  708. command_tbl.9  = "[T]erminate Host mode ; 9"
  709. command_tbl.10 = "[U]pload A File ; 1"
  710.  
  711. cmd_desc. = ''
  712. cmd_name. = ''
  713. cmd_reqs  = ''
  714.  
  715. j = 0
  716. Do i = 1 until command_tbl.i = ''
  717.    Parse var command_tbl.i tbl_command tbl_desc ';' tbl_priv
  718.    If tbl_priv > priv then iterate
  719.  
  720.    /*==================================================================*/
  721.    /*  Look for "[" in command Next Letter is Command, Save this       */
  722.    /*       command character for later checking                       */
  723.    /*==================================================================*/
  724.    start = pos('[', tbl_command) + 1
  725.    cmd_reqs = cmd_reqs || substr(tbl_command, start, 1)
  726.  
  727.    j = j + 1
  728.    cmd_name.j = tbl_command
  729.    cmd_desc.j = tbl_desc
  730. End
  731. num_of_cmds = j
  732. Return
  733.  
  734.  
  735. List_files: Procedure expose (expose_list)
  736. Parse value read_with_echo("Enter wildcard for files or Tap [Return] for ALL files?-> ") with rc wildcard .
  737. If rc \=0 then return rc
  738.  
  739. Do i=1 until i=dir_line.0
  740.    If default_dir = dir_name.i then
  741.       Do
  742.          Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,port
  743.          Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,screen_handle
  744.          Leave
  745.       End
  746. End
  747.  
  748. queue = 'PMCOMMQ'
  749. rc = rxqueue('delete',queue)
  750. rc = rxqueue('create',queue)
  751. rc = rxqueue('set',queue)
  752. Address CMD 'DIR' wildcard '/N 2>NUL | RXQUEUE' queue
  753. If queued() <= 5 then
  754.    Do
  755.      Call put_s crlf||'No files Found or Directory Empty' crlf,port
  756.      Call put_s crlf||'No Files Found or Directory Empty' crlf,screen_handle
  757.      rc = rxqueue('delete',queue)
  758.      Return 0
  759.    End
  760. Do 4
  761.    Parse pull .
  762. End
  763. Do i=1 until queued()-1 <= 0
  764.    Parse pull d_date d_time d_bytes . d_file
  765.    If priv < 5 & datatype(d_bytes,'N') = 0 then iterate
  766.     outline = left(d_file,13) right(d_bytes,8) right(d_date,10)
  767.     Call Put_s outline crlf,port
  768.     Call Put_s outline crlf,screen_handle
  769.     x = i // 21
  770.     If x = 0 then
  771.       Do
  772.         Parse value read_with_echo("More - Tap [Return] to continue or Q to abort?-> ") with rc more .
  773.         If rc \=0 then return rc
  774.         If more \= '' then leave
  775.       End
  776. End
  777. rc = rxqueue('delete',queue)
  778. Return 0
  779.  
  780.  
  781. List_Directories: Procedure expose (expose_list)
  782. Do forever
  783. Parse value read_with_echo("List - [1.."||dir_line.0||"], [L]ist, [Return] to abort?-> ") with rc func .
  784. If rc \=0 then return rc
  785. If func = '' then return 0
  786. If func = 'L' then
  787.   Do
  788.     Do i=1 until i=dir_line.0
  789.        Call Put_s '['||i||']' dir_desc.i crlf,port
  790.        Call Put_s '['||i||']' dir_desc.i crlf,screen_handle
  791.        x = i // 21
  792.        If x = 0 then
  793.          Do
  794.             Parse value read_with_echo("More - Tap [Return] to continue or Tap Any Key to abort?-> ") with rc more .
  795.             If rc \=0 then return rc
  796.             If more \= '' then leave
  797.          End
  798.     End
  799. Iterate
  800. End
  801.  
  802. If datatype(func,'N')=1 then
  803.    Do
  804.      If func > 0 & func <= dir_line.0 then
  805.         Do
  806.            Parse value directory(dir_name.func) with default_dir
  807.            Parse value List_Files() with rc
  808.         End
  809.    End
  810. Iterate
  811. End
  812. Return 0
  813.  
  814.  
  815. Change_dir: Procedure expose (expose_list)
  816. Parse value directory() with default_dir
  817.  
  818. Call Put_s crlf||"Current directory is " default_dir crlf,port
  819. Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
  820. Do Forever
  821.   Parse value read_with_echo("Enter new directory name or Tap [Return] to abort?-> ") with rc newdir .
  822.   If rc \=0 then return rc
  823.   If newdir = '' then return 0
  824.   Parse value directory(newdir) with tempdir
  825.   If tempdir  \= '' then
  826.      Do
  827.        Call Put_s 'Default directory changed to' newdir crlf,port
  828.        Call Put_s 'Default directory changed to' newdir crlf,screen_handle
  829.        default_dir = newdir
  830.        upload_dir  = newdir
  831.        Call Set_Download_Path newdir,dde_output
  832.      End
  833.        Else do
  834.        Call Clear
  835.        Call Put_s crlf||'Directory' newdir 'not found ...' crlf,port
  836.        Call Put_s crlf||'Directory' newdir 'not found ...' crlf,screen_handle
  837.        Iterate
  838.      End
  839.   Return 0
  840. End
  841.  
  842.  
  843. Set_protocol: Procedure expose (expose_list)
  844. protocol_sel = "[X]modem [C]rc-Xmodem [1]k-Xmodem [B]atch-Ymodem [Y]modem-G [K]ermit [Z]modem [N]one"
  845. Parse arg call_type
  846. If call_type = '' then
  847.    Do
  848.      Call Put_s crlf||"Current file transfer protocol is" protocol crlf,port
  849.      Call Put_s crlf||"Current file transfer protocol is" protocol crlf,screen_handle
  850.    End
  851.    Else Do
  852.      Call Put_s crlf crlf,port
  853.      Call Put_s crlf,screen_handle
  854.    End
  855.  
  856. cmdline = ''
  857. Do i = 1 to words(protocol_sel)
  858.    Call Put_s word(protocol_sel,i) crlf ,port
  859.    Call Put_s word(protocol_sel,i) crlf ,screen_handle
  860.    cmdline = cmdline substr(word(protocol_sel,i),2,1)
  861. End
  862. cmdline = space(cmdline,1,',')
  863.  
  864. Do Forever
  865.   Parse value read_with_echo("Enter choice" cmdline "or Tap [Return] to abort?-> ") with rc pick .
  866.   If rc \=0 then return rc
  867.   If pick = '' then return 0
  868.   Select
  869.        When pick = "X" then protocol = "XMODEM"
  870.        When pick = "C" then protocol = "XMODEM-CRC"
  871.        When pick = "1" then protocol = "XMODEM-1K"
  872.        When pick = "B" then protocol = "YMODEM"
  873.        When pick = "Y" then protocol = "YMODEMG"
  874.        When pick = "Z" then protocol = "ZMODEM"
  875.        When pick = "K" then protocol = "KERMIT"
  876.        When pick = "N" then protocol = "NONE"
  877.        Otherwise iterate
  878.   End
  879.   Leave
  880. End
  881. Return 0
  882.  
  883.  
  884. Set_password: Procedure expose (expose_list)
  885. Parse value read_with_echo("Enter new password or Tap [Return] to abort?-> ") with rc tword .
  886. If rc \=0 then return rc
  887. If tword = '' then return 0
  888. pword = tword
  889. Call Update_password_file(pass_file temp_file)
  890. Call Put_s crlf||'Password changed ...' crlf crlf,port
  891. Call Put_s crlf||'Password changed ...' crlf crlf,screen_handle
  892. Return 0
  893.  
  894.  
  895. Shell_OS2: Procedure expose (expose_list)
  896. Call OS2_Shell port,port
  897. Return 0
  898.  
  899.  
  900. User_Information: Procedure expose (expose_list)
  901. Call Put_s 'Information - Self User Alterations' crlf crlf,port
  902. Call Put_s 'Information - Self User Alterations' crlf crlf,screen_handle
  903. Call Put_s "- First name ... :" fname crlf,port
  904. Call Put_s "- First name ... :" fname crlf,screen_handle
  905. Call Put_s "- Last name .... :" lname crlf,port
  906. Call Put_s "- Last name .... :" lname crlf,screen_handle
  907. Call Put_s "- Password ..... :" pword crlf,port
  908. Call Put_s "- Password ..... :" pword crlf,screen_handle
  909. Call Put_s "- Trans Protocol :" protocol crlf,port
  910. Call Put_s "- Trans Protocol :" protocol crlf,screen_handle
  911. Call Put_s "- Privilage .... :" priv crlf,port
  912. Call Put_s "- Privilage .... :" priv crlf,screen_handle
  913. Call Put_s "- Directory .... :" default_dir crlf crlf,port
  914. Call Put_s "- Directory .... :" default_dir crlf crlf,screen_handle
  915. Call Put_s "- Last call was on" last_login crlf,port
  916. Call Put_s "- Last call was on" last_login crlf,screen_handle
  917. Call Put_s "- Total number of calls todate is" total_logins crlf crlf,port
  918. Call Put_s "- Total number of calls todate is" total_logins crlf crlf,screen_handle
  919. Call Put_s "- Current date is" date() ", current time is" time('C') crlf,port
  920. Call Put_s "- Current date is" date() ", current time is" time('C') crlf,screen_handle
  921. Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,port
  922. Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,screen_handle
  923.  
  924.  
  925. Parse value read_with_echo("User Alterations - [P]assword, [T]rans, [Return] to quit?->") with rc attr
  926. If rc \=0 then return rc
  927. Select
  928.   When attr = 'T' then Parse value Set_protocol('NONE') with rc
  929.   When attr = 'P' then Parse value Set_password() with rc
  930.   Otherwise return 0
  931. End
  932. Return rc
  933.  
  934.  
  935. State_file: Procedure
  936. Parse arg file_name
  937. If file_name = '' then return file_name
  938. return(stream(file_name,'c','query exists'))
  939.  
  940.  
  941. Good_Bye: Procedure expose (expose_list)
  942. If fname = '' | lname = '' then return 99
  943. Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,port
  944. Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,screen_handle
  945. Call Put_s "Tap [Enter] to LogOff now." crlf,port
  946. Call Put_s "Tap [Enter] to LogOff now." crlf,screen_handle
  947. Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,port
  948. Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,screen_handle
  949. Call Clear_Buffer
  950. Call Read_timeout "1000",port
  951. Do i=9 by -1 until i = 0
  952.   Call Put_s "Hanging up in :" i "seconds" cr,port
  953.   Call Put_s "Hanging up in :" i "seconds" cr,screen_handle
  954.   Parse value Get_CH(port) with char_in
  955.   If char_in = "-1" then iterate
  956.   If char_in = esc then return 0
  957.   Leave
  958. End
  959. Call Put_s crlf||"Loggoff for" fname lname "complete" crlf,port
  960. Call Put_s crlf||"Loggoff for" fname lname "complete" crlf ,screen_handle
  961. Call Audit(date() time('C') "- Logoff by" fname lname)
  962. Call Update_Password_file(pass_file temp_file)
  963. Return 99
  964.  
  965.  
  966. Kill_host_mode:
  967. Parse value directory(orgdir) with rc
  968. Call Put_s crlf||"Directory reset to" orgdir crlf,screen_handle
  969. Call Put_s "PMComm Host Mode Terminating ..." crlf,port
  970. Call Put_s "PMComm Host Mode Terminating ..." crlf,screen_handle
  971. If connection = 'MODEM' then
  972.   Do
  973.     Call Clear_buffer
  974.     Call Drop_DTR port
  975.     Call Sleep "2000"
  976.     Call Raise_DTR port
  977.     Call Put_s 'ATZ'||cr,port
  978.     Call wait_for "OK",port
  979.     Call Sleep "2000"
  980.   End
  981. Exit
  982.